Cream of the Crop 11/Cream of the Crop 11-1.iso/comm/ftp4w24b.zip/vb/ftpproto.frm

Text File | 1995-02-28 | 13KB | 485 lines

VERSION 2.00
Begin Form FTP_form
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   3  'Fixed Double
   Caption         =   "FTP file transfer utility "
   ClientHeight    =   4020
   ClientLeft      =   1005
   ClientTop       =   2385
   ClientWidth     =   8085
   Height          =   4710
   Icon            =   FTPPROTO.FRX:0000
   Left            =   945
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   4020
   ScaleWidth      =   8085
   Top             =   1755
   Width           =   8205
   Begin ListBox Dir_list
      Height          =   2955
      Left            =   120
      TabIndex        =   4
      Top             =   480
      Width           =   7815
   End
   Begin Line Line1
      X1              =   0
      X2              =   8040
      Y1              =   3480
      Y2              =   3480
   End
   Begin Label Message
      DragMode        =   1  'Automatic
      Height          =   255
      Left            =   1320
      TabIndex        =   1
      Top             =   3600
      Width           =   4815
   End
   Begin Label Label3
      BackColor       =   &H00C0C0C0&
      Caption         =   "Messages :"
      Height          =   255
      Left            =   240
      TabIndex        =   3
      Top             =   3600
      Width           =   1095
   End
   Begin Label Host_name
      BackColor       =   &H00C0C0C0&
      Caption         =   "< Not connected >"
      Height          =   255
      Left            =   1680
      TabIndex        =   2
      Top             =   120
      Width           =   1695
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Host :"
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   1215
   End
   Begin Menu Menu_connection
      Caption         =   "&Action"
      Begin Menu Menu_connection_item
         Caption         =   "&Connect.."
         Index           =   0
      End
      Begin Menu Menu_connection_item
         Caption         =   "&Disconnect.."
         Index           =   1
      End
      Begin Menu Menu_connection_item
         Caption         =   "&Abort"
         Index           =   2
      End
      Begin Menu Menu_connection_item
         Caption         =   "&Exit"
         Index           =   3
      End
   End
   Begin Menu Menu_file
      Caption         =   "&File"
      Begin Menu Menu_file_item
         Caption         =   "&Get.."
         Index           =   0
      End
      Begin Menu Menu_file_item
         Caption         =   "&Put.."
         Index           =   1
      End
   End
   Begin Menu Menu_directory
      Caption         =   "&Directory"
      Begin Menu Menu_directory_item
         Caption         =   "&Change"
         Index           =   0
      End
      Begin Menu Menu_directory_item
         Caption         =   "&Parent"
         Index           =   1
      End
      Begin Menu Menu_directory_item
         Caption         =   "&Dir list"
         Index           =   2
      End
   End
   Begin Menu Menu_settings
      Caption         =   "&Settings"
      Begin Menu Menu_setting_items
         Caption         =   "&Ascii type"
         Index           =   0
      End
      Begin Menu Menu_setting_items
         Caption         =   "&Binary type"
         Index           =   1
      End
      Begin Menu Menu_setting_items
         Caption         =   "&Mask"
         Index           =   2
      End
   End
   Begin Menu Quote_menu
      Caption         =   "&Quote"
      Begin Menu Quote_command
         Caption         =   "&Command"
      End
   End
   Begin Menu AboutMenu
      Caption         =   "A&bout"
   End
End
Const MB_YESNO = 4, MB_ICONSTOP = 16, MB_DEFBUTTON2 = 256
Const ID_YES = 6, ID_NO = 7

Sub AboutMenu_Click ()
  '
  Dim Msg, Endofl
  Endofl = Chr$(13) & Chr$(10)
  '
  Msg = "   FTP File transfer utility" & Endofl
  Msg = Msg & "   developed in Visual Basic" & Endofl
  Msg = Msg & "      by Kees de Rooij and " & Endofl
  Msg = Msg & "Richard Terpstra ([e-mail])" & Endofl
  Msg = Msg & " " & Endofl
  Msg = Msg & "using FTP4W.DLL from Ph. Jounin (SNCF)" & Endofl
  '
  MsgBox Msg, 64, "About"
  '
End Sub

Sub Disable_menus ()
  '
  Menu_connection.Enabled = False
  Menu_file.Enabled = False
  Menu_directory.Enabled = False
  Menu_settings.Enabled = False
  Quote_menu.Enabled = False
  '
End Sub

Sub Do_display_options ()
  '
  Disable_menus
  Ftp_form!Message.Caption = ""
  Ftp_form.MousePointer = 11
  '
End Sub

Sub Enable_menus ()
  '
  Menu_connection.Enabled = True
  Menu_file.Enabled = True
  Menu_directory.Enabled = True
  Menu_settings.Enabled = True
  Quote_menu.Enabled = True
  '
End Sub

Function Exit_program () As Integer
  'give a message box to enable the operator to terminate
  'the program or not
  '
  Dim DgDef, Msg, Response, Title
  '
  Title = "Close application"
  Msg = "The application is still connected " & Chr$(13) & Chr$(10)
  Msg = Msg & "Do you want to finish anyway ?"
  DgDef = MB_YESNO + MB_ICONSTOP + MB_DEFBUTTON2
  Response = MsgBox(Msg, DgDef, Title)
  '
  Exit_program = Response
  '
End Function

Sub Form_Load ()
  '
  Connected = False
  DirType = False
  TransType = Asc(TYPE_A)
  MaskType = "*.*"
  '
  Success = FtpInit(Hwnd)
  If Success = FTPERR_OK Then
    FtpSetSynchronousMode
    Success = FtpSetType(TransType)
  Else
    Ms$ = FTP4W_Error(Success)
    Ftp_form!Message.Caption = Ms$
  End If
  '
End Sub

Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer)
  '
  'when finishing via - control program checks for connected
  'and gives a message to the operator, he then can decide
  'to finish or not
  'Also a warning will be given when the release was not
  'successfull
  '
  If Connected Then
    If Exit_program() = ID_YES Then
      Success = FtpLocalClose()  'do both Close
      Success = FtpRelease()     'and Release
      If Success <> FTPERR_OK Then
        MsgBox "The application has not been Released succesfully", 64, "Information"
        Cancel = False
      End If
      Cancel = False
    Else
      Cancel = True
    End If
  Else
    Ftp_form!Message.Caption = ""
    Success = FtpLocalClose()  'do both Close
    Success = FtpRelease()     'and Release
    If Success <> FTPERR_OK Then
      MsgBox "The application has not been Released succesfully", 64, "Information"
    End If
    Cancel = False
  End If
  '
End Sub

Sub Menu_connection_Click ()
  'set menu active depending on connection
  'connect
  Menu_connection_item(0).Enabled = (Connected = False)
  'disconnect
  Menu_connection_item(1).Enabled = (Connected = True)
  'abort
  Menu_connection_item(2).Enabled = (Connected = True)
  '
End Sub

Sub Menu_connection_item_Click (Index As Integer)
  'do action depending on item
  '
  Select Case Index
  Case 0                    'Connect
    ConnectForm.Show 1
    If OKDialog = False Then
      Exit Sub
    End If
    Do_display_options
    Success = FtpLogin(HostName, Userid, Password, Hwnd, w%)
    Undo_display_options
    If Success = FTPERR_OK Then
      Connected = True
      Ftp_form.Host_name.Caption = HostName
    Else
      Ms$ = FTP4W_Error(Success)
      Ftp_form!Message.Caption = Ms$
    End If
  Case 1                    'Disconnect
    Do_display_options
    Success = FtpCloseConnection()
    Undo_display_options
    If Success = FTPERR_OK Then
      Connected = False
      Ftp_form.Host_name.Caption = "< Not connected >"
    Else
      Ms$ = FTP4W_Error(Success)
      Ftp_form!Message.Caption = Ms$
    End If
  Case 2                    'Abort
    Do_display_options
    Success = FtpAbort()
    Undo_display_options
    If Success <> FTPERR_OK Then
      Ms$ = FTP4W_Error(Success)
      Ftp_form!Message.Caption = Ms$
    Else
      Ftp_form!Message.Caption = "Abort OK"
    End If
  Case 3                    'Exit
    If Connected Then       'when connected show tha dialog
      If Exit_program() = ID_YES Then
        Success = FtpLocalClose()  'do both Close
        Success = FtpRelease()     'and Release
        If Success <> FTPERR_OK Then
          MsgBox "The Application has not been released succesfully", 64, "Info"
        End If
        End                      'exit program
      End If
    Else   'not connected
      Success = FtpLocalClose()  'do both Close
      Success = FtpRelease()     'and Release
      If Success <> FTPERR_OK Then
        MsgBox "The Application has not been released succesfully", 64, "Info"
      End If
      End                        'exit program
    End If
  End Select
  '
End Sub

Sub Menu_directory_Click ()
  'set menu active depending on connection
  'change
  Menu_directory_item(0).Enabled = (Connected = True)
  'parent
  Menu_directory_item(1).Enabled = (Connected = True)
  'dir list
  Menu_directory_item(2).Enabled = (Connected = True)
  '
End Sub

Sub Menu_directory_item_Click (Index As Integer)
  '
  Dim C_dir$
  '
  Select Case Index
  Case 0          'change
    C_dir$ = InputBox$("Enter directory name : ", "Change directory")
    Do_display_options
    Success = FtpCWD(C_dir$)
    Undo_display_options
    If Success <> FTPERR_OK Then
      Ms$ = FTP4W_Error(Success)
      Ftp_form!Message.Caption = Ms$
    Else
      Ftp_form!Message.Caption = "Change dir OK"
    End If
  Case 1          'parent
    C_dir$ = ".."
    Do_display_options
    Success = FtpCWD(C_dir$)
    Undo_display_options
    If Success <> FTPERR_OK Then
      Ms$ = FTP4W_Error(Success)
      Ftp_form!Message.Caption = Ms$
    Else
      Ftp_form!Message.Caption = "Change dir OK"
    End If
  Case 2
    DirType = False
    Do_display_options
    Do_the_dirlist
    Ftp_form.MousePointer = 0
    Enable_menus
  End Select
  '
End Sub

Sub Menu_file_Click ()
  'set menu active depending on connection
  'put
  Menu_file_item(0).Enabled = (Connected = True)
  'get
  Menu_file_item(1).Enabled = (Connected = True)
  '
End Sub

Sub Menu_file_item_Click (Index As Integer)
  '
  Select Case Index
  Case 0      'get
    Get_file.Show 1
    If OKDialog = False Then Exit Sub
    '
    Do_display_options
    Success = FtpRecvFile(Src_nam, Dest_nam, TransType, BNotify%, Hwnd, Msg%)
    Undo_display_options
    If Success <> FTPERR_OK Then
      Ms$ = FTP4W_Error(Success)
      Ftp_form!Message.Caption = Ms$
    Else
      Ftp_form!Message.Caption = "Receive file OK"
    End If
  Case 1      'put
    Put_file.Show 1
    If OKDialog = False Then Exit Sub
    Do_display_options
    Success = FtpSendFile(Src_nam, Dest_nam, TransType, BNotify%, Hwnd, Msg%)
    Undo_display_options
    If Success <> FTPERR_OK Then
      Ms$ = FTP4W_Error(Success)
      Ftp_form!Message.Caption = Ms$
    Else
      Ftp_form!Message.Caption = "Send file OK"
    End If
  End Select
  '
End Sub

Sub Menu_setting_items_Click (Index As Integer)
  '
  Select Case Index
  Case 0                     'Ascii
    TransType = Asc(TYPE_A)
  Case 1                     'binary
    TransType = Asc(TYPE_I)
  Case 2                     'mask
    MaskType = Get_mask_type()
    Do_display_options
    Do_the_dirlist
    Ftp_form.MousePointer = 0
    Enable_menus
  End Select
  '
End Sub

Sub Menu_settings_Click ()
  '
  Menu_setting_items(0).Checked = (TransType = Asc(TYPE_A))
  Menu_setting_items(1).Checked = (TransType = Asc(TYPE_I))
  '
  Menu_setting_items(0).Enabled = (Connected = True)
  Menu_setting_items(1).Enabled = (Connected = True)
  Menu_setting_items(2).Enabled = (Connected = True)
  '
End Sub

Sub Quote_command_Click ()
  'execute a command not implemented as standard command
  'in FTP4W.BAS
  '
  Dim Answ$, DefVal, Msg, Title
  Dim Result As String
  '
  Result = String$(255, 32)     'init the string ! essential
  '
  DefVal = ""
  Msg = "Enter FTP command : "
  Title = "Quote option for FTP"
  '
  Answ$ = InputBox$(Msg, Title, DefVal)
  If Len(Trim$(Answ$)) = 0 Then
    Exit Sub
  Else
    Do_display_options
    Success = FtpQuote(Answ$, Result, Len(Result))
    Undo_display_options
    If Success = FTPERR_OK Then
      Result = Trim$(Result)
      Result = Left$(Result, Len(Result) - 1)
      Ftp_form!Message.Caption = "FTP Quote OK" 'Result
    Else
      M$ = FTP4W_Error(Success)
      Ftp_form!Message.Caption = M$
    End If
  End If
  '
End Sub

Sub Quote_menu_Click ()
  '
  Quote_command.Enabled = (Connected = True)
  '
End Sub

Sub Undo_display_options ()
  '
  Ftp_form.MousePointer = 0
  Enable_menus
  '
End Sub